Covid19 Japan

Covid19 Japanが独自に収集している陽性確定者単位のデータ。ソースとデータは全てGitHubにて公開されているが、データはJSON形式である点に注意。発表後に修正されたレコード（インスタンス）は削除されれずにステータスなどが変更されているだけなので、「レコード数 \(\neq\) 累計陽性確定者」である点に注意。

Import

Covid19 JapanがGitHubで公開しているデータはJSOM形式のため、また、最新データがインデックスで示されているため、読み込むには少し工夫が必要である。

Patient Data

陽性者単位のデータ。

path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/patient_data/"

data_at <- readr::read_lines(paste0(path, "latest.json")) %>% 
  stringr::str_sub(start = 1L, end = -6L)

df <- path %>% 
  paste0("latest.json") %>% 
  readr::read_lines() %>% 
  paste0(path, .) %>% 
  jsonlite::fromJSON()

df

Summary Data 【参考】

死亡者数や重症者数などの推移データはsummaryフォルダ内のJSON形式ファイルにまとめられている。summaryフォルダの他にsummary_minフォルダというフォルダがあるが、summary_minフォルダ内のJSONファイルは改行を省略した形式のファイル。

path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/summary/"

df_s <- path %>% 
  paste0("latest.json") %>% 
  readr::read_lines() %>% 
  paste0(path, .) %>% 
  jsonlite::fromJSON()

df_s %>% summary()

##             Length Class      Mode     
## prefectures 27     data.frame list     
## regions     12     data.frame list     
## daily       37     data.frame list     
## updated      1     -none-     character

　
要約すると分かるが、3つのデータフレームと一つのベクトルから構成されている。参考までに各データの内容を簡単に紹介する。

都道府県単位集計

厳密には都道府県＋空港検疫・ダイヤモンドプリンセス・長崎クルーズ船・その他の51区分になっておえい、一部の変量（フィーチャー）がネストされている。

df_s$prefectures

地方単位集計

いわゆる八地方区分単位で集計されているデータ。こちらも都道府県単位集計と同様に一部の変量（フィーチャー）がネストされている。ただし、ネストされている変量（フィーチャー）を展開・集計しても集計値とは異なっている。

df_s$regions

日次集計

発表があった日ごとにまとめているデータ（個票データを集計したもの）。最初の行（インスタンス、レコード）の日付がおかしい点に注意（他のデータから推測すると恐らく“2020-01-08”）。

df_s$daily

更新日時

集計データファイル（JSON形式）の更新日時が記録されている。

df_s$updated

## [1] "2020-11-02T23:09:44+09:00"

Area Data

Covid19 Japanのデータは陽性者単位のデータであるため、報告主体である都道府県のデータが含まれている。これを利用して地域・地方ごとの分類を行う場合に使える都道府県データを用意した。この都道府県データはGistにて公開している。

Data Wrangling (tidy and transform)

Summarize

まず、オリジナルのデータがどのようになっているかskimrパッケージを用いてサマライズしておく。

df %>% 
  skimr::skim()

Data summary
Name	Piped data
Number of rows	104087
Number of columns	23
_______________________
Column type frequency:
character	19
logical	3
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	n_unique	whitespace
patientId	0	1.00	1	8	102428	0
dateAnnounced	0	1.00	10	10	279	0
gender	14180	0.86	1	1	2	0
detectedPrefecture	0	1.00	3	15	49	0
patientStatus	100131	0.04	8	23	8	0
notes	53913	0.48	1	270	47412	1
mhlwPatientNumber	103638	0.00	1	11	434	0
prefecturePatientNumber	12018	0.88	5	20	92060	0
prefectureSourceURL	72783	0.30	5	224	3439	0
residence	22022	0.79	1	38	1422	0
sourceURL	637	0.99	1	239	7939	0
relatedPatients	93691	0.10	2	259	6345	0
knownCluster	101605	0.02	3	88	229	0
detectedCityTown	78088	0.25	2	22	663	0
cityPrefectureNumber	78353	0.25	1	34	25725	2
citySourceURL	92255	0.11	9	317	3637	0
deceasedDate	102290	0.02	10	10	229	0
deceasedReportedDate	102873	0.01	10	62	204	0
deathSourceURL	103017	0.01	14	123	651	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
confirmedPatient	0	1	0.98	TRU: 102427, FAL: 1660
charterFlightPassenger	104073	0	1.00	TRU: 14
cruisePassengerDisembarked	104076	0	1.00	TRU: 11

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
ageBracket	0	1	32.65	23.57	-1	20	30	50	100	▅▇▅▂▁

　
元がJSON形式なので、読み込んだ直後は殆どの変量（フィーチャー）が文字型になっていることが分かる。また、意外と欠損が多いことも分かるので、欠損が非常に多い変量は除いておくことにする。

Transform

各変量（フィーチャー）を適切な形式に変換し、地域区分でも分析できるように都道府県データと結合します。

x <- df %>% 
  dplyr::select(patientId, date = dateAnnounced, gender,
                pref = detectedPrefecture, patientStatus, knownCluster,
                confirmedPatient, charterFlightPassenger,
                cruisePassengerDisembarked, ageBracket,
                deceasedDate, deceasedReportedDate) %>% 
  dplyr::filter(confirmedPatient == TRUE) %>% 
  dplyr::mutate(date = lubridate::as_date(date),
                gender = forcats::as_factor(gender),
                patientStatus = forcats::as_factor(patientStatus),
                cluster = dplyr::if_else(!is.na(knownCluster), TRUE, FALSE),
                ageBracket = forcats::as_factor(ageBracket),
                deceasedDate = lubridate::as_date(deceasedDate),
                deceasedReportedDate = lubridate::as_date(deceasedReportedDate)) %>% 
  dplyr::left_join(prefs, by = c("pref" = "pref")) %>% 
  dplyr::rename(Pref = `都道府県`, region = `八地方区分`, population = `推計人口`)

## Warning: Problem with `mutate()` input `deceasedReportedDate`.
## ℹ  2 failed to parse.
## ℹ Input `deceasedReportedDate` is `lubridate::as_date(deceasedReportedDate)`.

## Warning: 2 failed to parse.

x %>% 
  skimr::skim()

Data summary
Name	Piped data
Number of rows	102427
Number of columns	20
_______________________
Column type frequency:
character	3
Date	3
factor	9
logical	4
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	n_unique
patientId	0	1.00	1	8	102427
pref	0	1.00	3	15	49
knownCluster	99974	0.02	3	88	227

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
date	0	1	2020-01-15	2020-11-02	2020-08-12	279
deceasedDate	102048	0	2020-02-13	2020-10-17	2020-05-08	150
deceasedReportedDate	102097	0	2020-02-13	2020-10-17	2020-05-16	131

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
gender	13543	0.87	FALSE	2	M: 49916, F: 38968
patientStatus	99894	0.02	FALSE	8	Hos: 1261, Dec: 371, Hom: 315, Dis: 283
ageBracket	0	1.00	FALSE	13	20: 24465, 30: 15417, -1: 13642, 40: 12751
pcode	1203	0.99	FALSE	47	13: 31323, 27: 12950, 14: 8812, 23: 6326
Pref	1203	0.99	FALSE	47	東京都: 31323, 大阪府: 12950, 神奈川: 8812, 愛知県: 6326
region	1203	0.99	FALSE	8	関東地: 53296, 近畿地: 20358, 九州地: 10913, 中部地: 9917
広域圏	7869	0.92	FALSE	8	首都圏: 53514, 近畿圏: 19791, 中部圏: 8590, 九州圏: 7537
通俗的区分	1203	0.99	FALSE	11	関東: 53296, 関西: 19791, 東海: 8247, 九州: 7537
fct_pref	1203	0.99	FALSE	47	Tok: 31323, Osa: 12950, Kan: 8812, Aic: 6326

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
confirmedPatient	0	1	1.00	TRU: 102427
charterFlightPassenger	102413	0	1.00	TRU: 14
cruisePassengerDisembarked	102416	0	1.00	TRU: 11
cluster	0	1	0.02	FAL: 99974, TRU: 2453

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
population	1203	0.99	8369.87	4349.33	560	5286	8813	13822	13822	▅▃▅▆▇

　
文字型を因子型に変換するだけでも大まかな傾向が見える。例えば

年齢別で見ると20代、30代、年齢非回答、40代の順に陽性者が多い
都道府県では人口の多い、東京、大阪、神奈川、愛知の順
地方区分で見ると関東、近畿、九州、中部となっており九州地方が以外と多い

ことが読める。

parientStatusは症状（状態）と状況が混在しているため、分かりにくいが以下の通りである。なお、Unspecifiedとは別に欠損値（NA）もある。

levels	意味
Hospitalized	入院中
Critical (Hospitalized)	重症（入院中）
Home Quarantine	自宅療養中
Hotel Quarantine	ホテル療養中
Recoverd	回復
Discharged	退院済
Deceased	死亡
Unspecified	詳細不明

都道府県別集計

都道府県別の総陽性者数を求め、上位10県と下位10県を求めてみる。

x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n())

x %>% 
  dplyr::group_by(Pref, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  dplyr::slice_max(order_by = n, n = 10)

x %>% 
  dplyr::group_by(Pref, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  dplyr::slice_min(order_by = n, n = 10)

八地方区分別集計

x %>% 
  dplyr::group_by(Pref, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  dplyr::group_by(region) %>% 
  dplyr::summarise(n = sum(n)) %>% 
  tidyr::pivot_wider(names_from = region, values_from = n)

x %>% 
  dplyr::group_by(date, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = region, values_from = n) %>% 
  dplyr::rename(`その他` = "NA") %>% 
  tidyr::complete(date = seq.Date(from = lubridate::as_date("2020-01-08"),
                                  to = max(date), by = "day")) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "regions", values_to = "n") %>% 
  tidyr::replace_na(list(n = 0L)) %>% 
  tidyr::pivot_wider(names_from = regions, values_from = n) %>% print() %>% 
  dplyr::summarise_if(is.integer, .funs = sum)

## # A tibble: 300 x 10
##    date       関東地方 中部地方 北海道地方 近畿地方 その他 九州地方 四国地方
##    <date>        <int>    <int>      <int>    <int>  <int>    <int>    <int>
##  1 2020-01-08        0        0          0        0      0        0        0
##  2 2020-01-09        0        0          0        0      0        0        0
##  3 2020-01-10        0        0          0        0      0        0        0
##  4 2020-01-11        0        0          0        0      0        0        0
##  5 2020-01-12        0        0          0        0      0        0        0
##  6 2020-01-13        0        0          0        0      0        0        0
##  7 2020-01-14        0        0          0        0      0        0        0
##  8 2020-01-15        1        0          0        0      0        0        0
##  9 2020-01-16        0        0          0        0      0        0        0
## 10 2020-01-17        0        0          0        0      0        0        0
## # … with 290 more rows, and 2 more variables: 東北地方 <int>, 中国地方 <int>

日次集計

日次の陽性者数、前日比、累計を求める。

x %>% 
  dplyr::group_by(date) %>% 
  dplyr::summarise(n = n()) %>% 
  tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day"),
                  fill = list(n = 0L)) %>% 
  dplyr::mutate(diff = n - dplyr::lag(n, default = 0L), cum = cumsum(n))

都道府県別日次集計

x_prefs <- x %>% 
  dplyr::group_by(date, Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "n")
x_prefs

lagdiff <- function(n) {
  n - dplyr::lag(n, default = 0L)
}

x_prefs_diff <- x_prefs %>% 
  tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>% 
  dplyr::mutate_if(is.integer, .funs = lagdiff) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "diff")
x_prefs_diff

x_prefs_cum <- x_prefs %>% 
  tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>% 
  dplyr::mutate_if(is.integer, .funs = cumsum) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "cum")
x_prefs_cum

x_by_prefs <- x_prefs %>% 
  dplyr::left_join(x_prefs_diff, by = c("date" = "date", "Pref" = "Pref")) %>% 
  dplyr::left_join(x_prefs_cum, by = c("date" = "date", "Pref" = "Pref")) %>% 
  dplyr::left_join(prefs, ., by = c("都道府県" = "Pref")) %>% 
  dplyr::mutate(Pref = forcats::fct_inorder(`都道府県`)) %>% 
  dplyr::select(date, Pref, n, diff, cum) %>% 
  dplyr::arrange(date)
x_by_prefs

八地方区分別日次集計

x_region <- x %>% 
  dplyr::group_by(date, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "n")
x_region

lagdiff <- function(n) {
  n - dplyr::lag(n, default = 0L)
}

x_region_diff <- x_region %>% 
  tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>% 
  dplyr::mutate_if(is.integer, .funs = lagdiff) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "diff")
x_region_diff

x_region_cum <- x_region %>% 
  tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>% 
  dplyr::mutate_if(is.integer, .funs = cumsum) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "cum")
x_region_cum

x_by_region <- x_region %>% 
  dplyr::left_join(x_region_diff, by = c("date" = "date", "region" = "region")) %>% 
  dplyr::left_join(x_region_cum, by = c("date" = "date", "region" = "region")) %>% 
  dplyr::left_join(prefs, ., by = c("八地方区分" = "region")) %>% 
  dplyr::mutate(region = forcats::fct_inorder(`八地方区分`)) %>% 
  dplyr::select(date, region, n, diff, cum) %>% 
  dplyr::arrange(date)
x_by_region

Visualizing

都道府県別日次推移

sec_scale <- 100
ncol <- 5

x_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "Fixed scale", x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者（単日）",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数（折線）")
    )

x_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
  ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "Free Y scale", x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者（単日）",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数（折線）")
    )

八地方区分別日次推移

sec_scale <- 10

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
    ggplot2::facet_wrap(~ region) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "Fixed scale", x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者（単日）",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数（折線）")
    )

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
    ggplot2::facet_wrap(~ region, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "Free Y scale", x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者（単日）",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数（折線）")
    )

Covid19, Japan

Covid19 Japan

Import

Patient Data

Summary Data 【参考】

都道府県単位集計

地方単位集計

日次集計

更新日時

Area Data

Data Wrangling (tidy and transform)

Summarize

Transform

都道府県別集計

八地方区分別集計

日次集計

都道府県別日次集計

八地方区分別日次集計

Visualizing

都道府県別日次推移

八地方区分別日次推移